SNA Week 3

Artem Aganov

Необходимые библиотеки — Кластерный анализ

Сегодня мы работаем преимущественно с igraph в первой части пары, все необходимое у вас уже должно быть установлено.

library(igraph)
library(intergraph)

Кластеры и сообщества

Сеть с явными сообществами

Подробно почитать об алгоритмах, которыми мы сегодня пользуемся, можно здесь: ссылка 1, ссылка 2

Создание примера сети

set.seed(123)
g = sample_islands(3, 10, 0.8, 3)  # 3 группы по 10 узлов
plot(g, vertex.size = 8, vertex.label = NA,
     main = "Пример сети с сообществами")

Алгоритм Louvain (самый популярный)

louvain_comm = cluster_louvain(g)

Результаты

kable(paste("Количество сообществ:", length(louvain_comm)))

x
Количество сообществ: 3

kable(paste("Модулярность:", round(modularity(louvain_comm), 3)))

x
Модулярность: 0.592

Размеры сообществ

table(membership(louvain_comm)) %>% kable()

Var1	Freq
1	10
2	10
3	10

Визуализация

plot(louvain_comm, g, 
     vertex.size = 8,
     vertex.label = NA,
     main = "Louvain algorithm")

Алгоритм Girvan-Newman (на основе меры посредничества)

gn_comm = cluster_edge_betweenness(g)

kable(paste("Количество сообществ:", length(gn_comm)))

x
Количество сообществ: 3

kable(paste("Модулярность:", round(modularity(gn_comm), 3)))

x
Модулярность: 0.592

plot(gn_comm, g,
     vertex.size = 8,
     vertex.label = NA,
     main = "Girvan-Newman algorithm")

Другие алгоритмы детекции сообществ

Fast greedy (быстрый, хорош для больших сетей)

fg_comm = cluster_fast_greedy(g)

Walktrap (случайные блуждания)

wt_comm = cluster_walktrap(g)

Label propagation (очень быстрый)

lp_comm = cluster_label_prop(g)

Infomap

im_comm = cluster_infomap(g)

Сравнение модулярности

data.frame(
  Algorithm = c("Louvain", "Girvan-Newman", "Fast Greedy", 
                "Walktrap", "Label Prop", "Infomap"),
  Modularity = c(
    modularity(louvain_comm),
    modularity(gn_comm),
    modularity(fg_comm),
    modularity(wt_comm),
    modularity(lp_comm),
    modularity(im_comm)
  ),
  Communities = c(
    length(louvain_comm),
    length(gn_comm),
    length(fg_comm),
    length(wt_comm),
    length(lp_comm),
    length(im_comm)
  )
) %>% arrange(-Modularity) %>% kable()

Algorithm	Modularity	Communities
Louvain	0.5919678	3
Fast Greedy	0.5919678	3
Walktrap	0.5919678	3
Girvan-Newman	0.5919678	3
Label Prop	0.5919678	3
Infomap	0.5919678	3

Интерпретация результатов

Получаем членство в сообществах

memb = membership(louvain_comm)

Анализ связей между сообществами

crossing_edges = crossing(louvain_comm, g)
kable(paste("Рёбер между сообществами:", sum(crossing_edges)))
kable(paste("Рёбер внутри сообществ:", sum(!crossing_edges)))

x
Рёбер между сообществами: 9

x
Рёбер внутри сообществ: 112

Матрица связей между сообществами

comm_matrix = table(
  Community_From = memb[get.edgelist(g)[,1]],
  Community_To = memb[get.edgelist(g)[,2]]
)
kable(comm_matrix)

1	2	3
36	3	3
0	37	3
0	0	39

Реальные данные (is Russia European after all?)

Вчитываем и конвертируем

load("introToSNAinR.Rdata")
gf = asIgraph(contig_1993)

Сравниваем разные методы

Кластеризация с помощью шести алгоритмов

louvain_comm_m = cluster_louvain(gf)
gn_comm_m = cluster_edge_betweenness(gf)
fg_comm_m = cluster_fast_greedy(gf)
wt_comm_m = cluster_walktrap(gf)
lp_comm_m = cluster_label_prop(gf)
im_comm_m = cluster_infomap(gf)

Сравнительная таблица (более краткий синтаксис)

comm_algorithms = list(Louvain = louvain_comm_m, "Girvan-Newman" = gn_comm_m, "Fast Greedy" = fg_comm_m,
  Walktrap = wt_comm_m, "Label Prop" = lp_comm_m, Infomap = im_comm_m)

data.frame(
  Modularity = sapply(comm_algorithms, modularity),
  Communities = sapply(comm_algorithms, length)
) %>% 
  arrange(-Modularity)

	Modularity	Communities
Louvain	0.7403351	13
Girvan-Newman	0.7335949	13
Walktrap	0.7173705	18
Infomap	0.7109249	21
Fast Greedy	0.6891824	10
Label Prop	0.6813779	21

Интерпретация результатов

Получаем членство в сообществах

memb_m = membership(louvain_comm_m)

Кто где находится?

V(gf)$community = memb_m
data.frame(country = V(gf)$State.Abb, community = V(gf)$community) %>%
  group_by(community) %>%
  summarise(n_states = n(),
    states = paste(country, collapse = ", "))

community	n_states	states
1	16	USA, CAN, BHM, CUB, HAI, DOM, JAM, MEX, BLZ, GUA, HON, SAL, NIC, COS, PAN, COL
2	19	TRI, BAR, DMA, GRN, SLU, SVG, AAB, SKN, VEN, GUY, SUR, ECU, PER, BRA, BOL, PAR, CHL, ARG, URU
3	22	UKG, IRE, NTH, BEL, LUX, FRN, LIE, SWZ, GMY, POL, AUS, CZR, SLO, RUS, EST, LAT, LIT, BLR, FIN, SWD, NOR, DEN
4	24	MNC, SPN, AND, POR, HUN, ITA, SNM, MLT, ALB, MAC, CRO, YUG, BOS, SLV, GRC, BUL, MLD, ROM, UKR, MAA, MOR, ALG, TUN, LIB
5	26	CYP, ARM, GRG, AZE, KEN, SOM, DJI, ETH, ERI, SUD, IRN, TUR, IRQ, EGY, SYR, LEB, JOR, ISR, SAU, YEM, KUW, BAH, QAT, UAE, OMA, PAK
6	1	ICE
7	22	CAP, STP, GNB, EQG, GAM, MLI, SEN, BEN, NIR, CDI, GUI, BFO, LBR, SIE, GHA, TOG, CAO, NIG, GAB, CEN, CHA, CON
8	19	DRC, UGA, TAZ, BUI, RWA, ANG, MZM, ZAM, ZIM, MAW, SAF, NAM, LES, BOT, SWA, MAG, COM, MAS, SEY
9	33	AFG, TKM, TAJ, KYR, UZB, KZK, CHN, MON, TAW, PRK, ROK, JPN, IND, BHU, BNG, MYA, SRI, MAD, NEP, THI, CAM, LAO, DRV, MAL, SIN, BRU, PHI, INS, AUL, PNG, VAN, SOL, FSM
10	1	NEW
11	1	FIJ
12	1	MSI
13	1	WSM

Анализ связей между сообществами

crossing_edges_m = crossing(louvain_comm_m, gf)
kable(paste("Рёбер между сообществами:", sum(crossing_edges_m)))
kable(paste("Рёбер внутри сообществ:", sum(!crossing_edges_m)))

x
Рёбер между сообществами: 67

x
Рёбер внутри сообществ: 467

Матрица связей

comm_matrix_m = table(
  Community_From = memb_m[get.edgelist(gf)[,1]],
  Community_To = memb_m[get.edgelist(gf)[,2]]
)
kable(comm_matrix_m)

	1	2	3	4	5	7	8	9
1	41	6	1	0	0	0	0	0
2	0	55	0	0	0	0	0	0
3	0	0	75	13	3	0	0	7
4	0	0	2	55	10	0	0	0
5	0	0	0	0	82	0	1	5
7	0	0	0	6	2	48	4	0
8	0	0	0	0	4	0	41	0
9	0	0	0	0	3	0	0	70

Визуализация с атрибутами

Цвета для сообществ

colors = rainbow(length(louvain_comm_m))
V(gf)$color = colors[memb_m]

Размер узлов по степени

V(gf)$size = degree(gf) / 2

Визуализация

plot(gf, 
     vertex.label = NA,
     edge.arrow.size = 0.3,
     main = "Сообщества с размером узлов по степени")

legend("topright", 
       legend = paste("Сообщество", 1:length(louvain_comm_m)),
       col = colors, pch = 19, pt.cex = 2)

Сравнение алгоритмов (визуально)

plot(louvain_comm_m, gf, vertex.size = 4, vertex.label = V(gf)$State.Abb, vertex.label.dist = 0.5,
     main = paste("Louvain ( Q =", round(modularity(louvain_comm_m), 2), ")"))
plot(gn_comm_m, gf, vertex.size = 4, vertex.label = V(gf)$State.Abb, vertex.label.dist = 0.5,
     main = paste("Girvan-Newman ( Q =", round(modularity(gn_comm_m), 2), ")"))
plot(fg_comm_m, gf, vertex.size = 4, vertex.label = V(gf)$State.Abb, vertex.label.dist = 0.5,
     main = paste("Fast Greedy ( Q =", round(modularity(fg_comm_m), 2), ")"))
plot(wt_comm_m, gf, vertex.size = 4, vertex.label = V(gf)$State.Abb, vertex.label.dist = 0.5,
     main = paste("Walktrap ( Q =", round(modularity(wt_comm_m), 2), ")"))
plot(lp_comm_m, gf, vertex.size = 4, vertex.label = V(gf)$State.Abb, vertex.label.dist = 0.5,
     main = paste("Label Prop ( Q =", round(modularity(lp_comm_m), 2), ")"))
plot(im_comm_m, gf, vertex.size = 4, vertex.label = V(gf)$State.Abb, vertex.label.dist = 0.5,
     main = paste("Infomap ( Q =", round(modularity(im_comm_m), 2), ")"))

Необходимые библиотеки и данные — Временные сети

Вторая часть разработана на основе материалов Brey (2018), URL: programminghistorian.org (не спрашивайте, как я нашел файлы) и Klein Schmidt (2021), URL: rpubs.com.

detach("package:igraph", unload = TRUE)
library(network)
library(sna)
#install.packages(c("tsna","ndtv"))
library(tsna)
library(ndtv)

Виньетку по пакету tsna можно найти здесь: https://cran.r-project.org/web/packages/tsna/vignettes/tsna_vignette.html

PHStaticEdges = read.csv("https://programminghistorian.org/assets/temporal-network-analysis-with-r/TNAWR_StaticEdgelist.csv")
PHVertexAttributes = read.csv("https://programminghistorian.org/assets/temporal-network-analysis-with-r/TNAWR_VertexAttributes.csv")
PHDynamicNodes = read.csv("https://programminghistorian.org/assets/temporal-network-analysis-with-r/TNAWR_DynamicNodes.csv")
PHDynamicEdges = read.csv("https://programminghistorian.org/assets/temporal-network-analysis-with-r/TNAWR_DynamicEdges.csv")

Анализ временных (динамических, темпоральных) сетей

Статичная сеть

thenetwork = network(PHStaticEdges,
                     vertex.attr = PHVertexAttributes, 
                     vertex.attrnames = c("vertex.id", "name", "region"),
                     directed = FALSE,
                     bipartite = FALSE,
                     multiple = TRUE)
plot(thenetwork)

Динамический объект

head(PHDynamicNodes)

onset	terminus	vertex.id	onset.censored	terminus.censored	duration
1280.0	1311.0	1	FALSE	FALSE	31.0
1288.5	1311.0	2	FALSE	FALSE	22.5
1257.5	1290.0	3	FALSE	FALSE	32.5
1280.0	1305.0	4	FALSE	FALSE	25.0
1272.5	1282.5	5	FALSE	FALSE	10.0
1272.5	1305.0	6	FALSE	FALSE	32.5

head(PHDynamicEdges)

onset	terminus	tail	head	onset.censored	terminus.censored	duration	edge.id
1300	1301	10	11	FALSE	FALSE	1	1
1300	1301	10	12	FALSE	FALSE	1	2
1320	1321	10	30	FALSE	FALSE	1	3
1320	1321	10	31	FALSE	FALSE	1	4
1310	1311	11	12	FALSE	FALSE	1	5
1300	1301	11	12	FALSE	FALSE	1	5

dynamicCollabs = networkDynamic(
  thenetwork,
  edge.spells = PHDynamicEdges,
  vertex.spells = PHDynamicNodes
)

## Edge activity in base.net was ignored
## Created net.obs.period to describe network
##  Network observation period info:
##   Number of observation spells: 1 
##   Maximal time range observed: 1257.5 until 1325 
##   Temporal mode: continuous 
##   Time unit: unknown 
##   Suggested time increment: NA

Проверка сети

network.dynamic.check(dynamicCollabs)

## $vertex.checks
##   [1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
##  [16] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
##  [31] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
##  [46] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
##  [61] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
##  [76] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
##  [91] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [106] TRUE
## 
## $edge.checks
##   [1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
##  [16] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
##  [31] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
##  [46] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
##  [61] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
##  [76] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
##  [91] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [106] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [121] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [136] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [151] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [166] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [181] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [196] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [211] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## 
## $dyad.checks
##   [1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
##  [16] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
##  [31] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
##  [46] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
##  [61] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
##  [76] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
##  [91] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [106] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [121] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [136] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [151] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [166] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [181] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [196] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [211] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## 
## $vertex.tea.checks
##   [1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
##  [16] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
##  [31] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
##  [46] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
##  [61] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
##  [76] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
##  [91] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [106] TRUE
## 
## $edge.tea.checks
##   [1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
##  [16] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
##  [31] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
##  [46] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
##  [61] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
##  [76] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
##  [91] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [106] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [121] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [136] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [151] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [166] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [181] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [196] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [211] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## 
## $network.tea.checks
## [1] TRUE
## 
## $net.obs.period.check
## [1] TRUE

Визуализация сети

Статика (по умолчанию)

plot(dynamicCollabs)

Всё точно так же, как и было со статичной сетью. Или нет? Почему?

Временные срезы

dynamicSimple = dynamicCollabs
dynamicSimple %n% "multiple" = FALSE 
filmstrip(dynamicSimple, displaylabels = F,
          frames = 9)

## No coordinate information found in network, running compute.animation

Описание динамики сетей

Формирование связей

plot(tEdgeFormation(dynamicCollabs, time.interval = .25))

Централизация сети

dynamicBetweenness = tSnaStats(
  dynamicCollabs,
  snafun = "centralization",
  start = 1260,
  end = 1320,
  time.interval = 1,
  aggregate.dur = 20,
  FUN = "betweenness"
)

Визуализация с помощью `ggplot2`

library(tibble)
library(ggplot2)

df_bet = tibble(
  time  = as.numeric(time(dynamicBetweenness)),
  value = as.numeric(dynamicBetweenness)
)
 ggplot(df_bet, aes(x = time, y = value)) +
  geom_line(linewidth = 0.5) +
  geom_point(size = 1.5) +
  labs(
    x = "Time",
    y = "Betweenness Centralization",
    title = "Dynamic Betweenness Centralization"
  ) +
  theme_minimal()

Пути во времени

v106path = tPath(dynamicCollabs, v = 106, start = 1260, direction = "fwd", end = 1290)
print(v106path)

## $tdist
##   [1] 25.0 25.0 12.5 12.5 12.5 17.5 12.5 12.5 20.0 20.0  Inf 15.0  Inf 12.5  Inf
##  [16] 25.0 12.5 12.5 12.5  Inf 12.5 15.0 12.5 17.5  Inf  Inf 12.0 12.5 12.0 12.0
##  [31] 12.5 12.5 15.0 15.0 12.0 12.5 12.5 12.5 12.5 20.0 20.0 12.5 12.5 12.0 15.0
##  [46] 12.5  Inf 29.0 19.5 12.5 12.5 17.5 19.5 12.5 12.5 17.5 12.5 12.5  0.0 25.0
##  [61] 25.0 25.0 12.5 17.5 17.5 12.5 12.5 12.5 20.0 20.0  Inf  Inf  Inf 15.0 15.0
##  [76] 12.5  Inf 12.5 12.5 12.5 12.5 15.0 12.5 17.5 12.0 12.0 12.5 12.0 12.5 12.5
##  [91] 15.0 15.0 12.0 12.5 12.5 20.0 12.5 15.0  Inf 12.5 12.5 25.0 19.5 12.5 12.5
## [106]  0.0
## 
## $previous
##   [1]  50  60   7   5  23   5   8  46   8   9   0  75   0   3   0   1  31   3
##  [19]  38   0  28  74  17  52   0   0  85  37  30  35   3  31  34  35  86  43
##  [37]  39  31  17  41   8  44  44  86  98  43   0  49  53  23   7  56  52  39
##  [55]  46  64  58  54 106   1   1   2   5   6   6   8   8   8   9  10   0   0
##  [73]   0  12  33  14   0  14  17  18  19  22  23  24 106  27  23  29  31  32
##  [91]  33  34  35  38  39  41  42  58   0  46  51  53  53  54  57   0
## 
## $gsteps
##   [1]  14  16   9  14  13  14   8   7   8   9 Inf   8 Inf  10 Inf  15  11  10
##  [19]  12 Inf  15  10  12  18 Inf Inf   2  14   6   5  10  11   6   5   4   6
##  [37]  13  11  12   9   8   5   5   4  16   6 Inf  20  19  13   9  17  18  13
##  [55]   7  16  15  14   1  15  15  17  14  15  15   8   8   8   9  10 Inf Inf
##  [73] Inf   9   7  11 Inf  11  12  11  13  11  13  19   1   3  13   7  11  12
##  [91]   7   6   5  12  13   9   6  15 Inf   7  10  19  19  14  16   0
## 
## $start
## [1] 1260
## 
## $end
## [1] 1290
## 
## $direction
## [1] "fwd"
## 
## $type
## [1] "earliest.arrive"
## 
## attr(,"class")
## [1] "tPath" "list"

Общая визуализация

coords = plot(dynamicCollabs,
     displaylabels = TRUE,
     label.cex = 0.8,
     label.pos = 5,
     vertex.col = 'white',
     vertex.cex = 3,
     edge.label.col = 'blue',
     edge.label.cex = 0.7
   )

Визуализация путей вперёд во времени

plot(v106path, coord = coords, displaylabels = TRUE)

Пересекаются ли сети для разных узлов?

Получим корректные индексы для лейблов “10” и “106”

vertex_names = network.vertex.names(dynamicCollabs)

v10_idx = which(vertex_names == "10")
v106_idx = which(vertex_names == "106")

cat("Index of vertex labeled '10':", v10_idx, "\n")

## Index of vertex labeled '10': 1

cat("Index of vertex labeled '106':", v106_idx, "\n")

## Index of vertex labeled '106': 102

Создадим пути с корректными индексами

v10path = tPath(dynamicCollabs, v = v10_idx, start = 1260, direction = "fwd", end = 1290)
v106path = tPath(dynamicCollabs, v = v106_idx, start = 1260, direction = "fwd", end = 1290)

Визуализация путей на соседних графах

par(mfrow = c(1, 2))

plotPaths(dynamicCollabs, v10path, coord = coords,
          vertex.col = ifelse(1:network.size(dynamicCollabs) == v10_idx, "red", 
                             ifelse(is.finite(v10path$tdist), "pink", "lightgray")),
          vertex.cex = ifelse(1:network.size(dynamicCollabs) == v10_idx, 3, 1.5),
          displaylabels = TRUE,
          label.cex = 0.6,
          main = 'Paths from vertex "10" (RED source)')

plotPaths(dynamicCollabs, v106path, coord = coords,
          vertex.col = ifelse(1:network.size(dynamicCollabs) == v106_idx, "blue",
                             ifelse(is.finite(v106path$tdist), "lightblue", "lightgray")),
          vertex.cex = ifelse(1:network.size(dynamicCollabs) == v106_idx, 3, 1.5),
          displaylabels = TRUE,
          label.cex = 0.6,
          main = 'Paths from vertex "106" (BLUE source)')

Сравним на одном графике

node_colors <- case_when(
  is.infinite(v10path$tdist) & is.infinite(v106path$tdist) ~ "gray",
  is.infinite(v106path$tdist) & is.finite(v10path$tdist) ~ "red",
  is.finite(v106path$tdist) & is.infinite(v10path$tdist) ~ "blue",
  v10path$tdist < v106path$tdist ~ "orange",
  v106path$tdist < v10path$tdist ~ "lightblue",
  TRUE ~ "green"
)

par(mfrow = c(1, 1))
plot(dynamicCollabs, coord = coords,
     vertex.col = node_colors,
     vertex.cex = 1.5,
     displaylabels = TRUE,
     label.cex = 0.6,
     main = 'Red = only "10" reaches, Blue = only "106" reaches, Orange = "10" closer')

legend("bottomright", 
       legend = c("Only '10' reaches", "Only '106' reaches", "'10' closer", "'106' closer", "Neither"),
       fill = c("red", "blue", "orange", "lightblue", "gray"),
       cex = 0.8)

	1	2	3	4	5	7	8	9
1	41	6	1	0	0	0	0	0
2	0	55	0	0	0	0	0	0
3	0	0	75	13	3	0	0	7
4	0	0	2	55	10	0	0	0
5	0	0	0	0	82	0	1	5
7	0	0	0	6	2	48	4	0
8	0	0	0	0	4	0	41	0
9	0	0	0	0	3	0	0	70

	1	2	3	4	5	7	8	9
1	41	6	1	0	0	0	0	0
2	0	55	0	0	0	0	0	0
3	0	0	75	13	3	0	0	7
4	0	0	2	55	10	0	0	0
5	0	0	0	0	82	0	1	5
7	0	0	0	6	2	48	4	0
8	0	0	0	0	4	0	41	0
9	0	0	0	0	3	0	0	70

SNA Week 3

Необходимые библиотеки — Кластерный анализ

Кластеры и сообщества

Сеть с явными сообществами

Создание примера сети

Алгоритм Louvain (самый популярный)

Результаты

Размеры сообществ

Визуализация

Алгоритм Girvan-Newman (на основе меры посредничества)

Другие алгоритмы детекции сообществ

Fast greedy (быстрый, хорош для больших сетей)

Walktrap (случайные блуждания)

Label propagation (очень быстрый)

Infomap

Сравнение модулярности

Интерпретация результатов

Получаем членство в сообществах

Анализ связей между сообществами

Матрица связей между сообществами

Реальные данные (is Russia European after all?)

Вчитываем и конвертируем

Сравниваем разные методы

Кластеризация с помощью шести алгоритмов

Сравнительная таблица (более краткий синтаксис)

Интерпретация результатов

Получаем членство в сообществах

Кто где находится?

Анализ связей между сообществами

Матрица связей

Визуализация с атрибутами

Цвета для сообществ

Размер узлов по степени

Визуализация

Сравнение алгоритмов (визуально)

Необходимые библиотеки и данные — Временные сети

Анализ временных (динамических, темпоральных) сетей

Статичная сеть

Динамический объект

Проверка сети

Визуализация сети

Статика (по умолчанию)

Временные срезы

Описание динамики сетей

Формирование связей

Централизация сети

Визуализация с помощью ggplot2

Пути во времени

Общая визуализация

Визуализация путей вперёд во времени

Пересекаются ли сети для разных узлов?

Визуализация с помощью `ggplot2`

	1	2	3	4	5	7	8	9
1	41	6	1	0	0	0	0	0
2	0	55	0	0	0	0	0	0
3	0	0	75	13	3	0	0	7
4	0	0	2	55	10	0	0	0
5	0	0	0	0	82	0	1	5
7	0	0	0	6	2	48	4	0
8	0	0	0	0	4	0	41	0
9	0	0	0	0	3	0	0	70